The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/astronut.src

Text File | 1991-05-29 | 6KB | 227 lines

%%HP: T(3)A(R)F(.);
@ ASTRONUT, by Kevin Jessup
@
DIR                   @ AstroNUT directory

  PLAY                @ push PLAY to start
    \<< RCLF 3 FIX    @ save flags
-19 CF # 83h # 40h    @ create a blank PICT
BLANK PICT STO 1 CF   @ clear the crash flag
170 'ht' STO          @ set height to 170 feet
-20 'v' STO 5         @ set vertical v to -20
      IF RAND .5 <    @ set horiz v to 5 or -5
      THEN NEG
      END 'hv' STO
RAND 80 * IP 'x'      @ random horiz position
STO 100 'fuel' STO    @ 100 unit of fuel
2 CF                  @ clear the bottom flag
MAKBOTTOM { # 0h      @ random terrain coordinates
# 0h } PVIEW MAIN     @ display and loop on main
CRASHht 'ht' STO      @ display landing parameters
CRASHx 'x' STO
CRASHv 'v' STO
STATUS PICT NEWC      @ display landing position
SHIP GXOR PICT {      @ display AstroNUT or CRASH
# 5h # 5h }
      IF CRASHv -4    @ test slope, vv and hv
< CRASHsl ABS .084
> OR hv OR
      THEN
"*CRASH*" LOOSE
      ELSE PICT 7
'ht' STO+ 1 'x'
STO+ NEWC aflag REPL
"AstroNUT" WIN
      END 3 \->GROB
REPL 7 FREEZE         @ freeze the display
globals PURGE         @ purge temporary globals
      WHILE KEY       @ flush any excess keys
      REPEAT DROP
      END STOF        @ restore flags and quit
    \>>

  WIN                 @ Play the WIN tune.
    \<< 125           @ "I am not a musician!"
      DO DUP .02
BEEP 2 *
      UNTIL DUP
4000 >
      END DROP
    \>>

  LOOSE               @ Play the LOOSE tune
    \<< 4000
      DO DUP .02
BEEP 2 /
      UNTIL DUP 125
<
      END DROP
    \>>

  MAIN                @ main processing loop
    \<<
      DO              @ draw or erase the terraine
        IF ht 56 >
        THEN
          IF 2 FS?
          THEN
ERASE 2 CF
          END
        ELSE
          IF 2 FC?
          THEN
DRAWBOTTOM 2 SF
          END
        END STATUS    @ display flight parameters
NEWC PICT OVER SHIP   @ display the lander
GXOR ht 20 * .01      @ beep based on altitude
BEEP v 'ht' STO+ hv   @ calculate new position
'x' STO+
        IF x 124 >    @ wrap horizontal
x 0 < OR
        THEN x 125
MOD ABS 'x' STO
        END
CHKBOTTOM GETKEY ag   @ see if we crashed, process keys
'v' STO+ PICT SWAP    @ acceleration increases v
SHIP GXOR             @ erase old position
      UNTIL 1 FS?     @ quit if we landed or crashed
      END
    \>>

@ CHKBOTTOM is the routine that eats all the CPU time.
@ If anyone knows how to speed it up, please do so.
@ It works by calculating linear regressions and then
@ comparing the line slopes.

  CHKBOTTOM           @ set flag 1 if we crashed
    \<< 1 botCOORDS   @ get terraine coordinates list size
SIZE 1 -
      FOR i           @ test each line segment
botCOORDS i GETI 3    @ get line endpoints
ROLLD GET DUP2 1      @ duplicate them
GET SWAP 1 GET        @ get the x coordinates and
        IF x 3 + \<=  @ see if lander is between them
SWAP x 3 + > AND
        THEN OVER     @ if so, compare line slopes
C\->V2 CL\GS \GS+ C\->V2 \GS+ @ calculate line slope
LR x DUP 'CRASHx'     @ calculate and save possible
STO 3 + PREDY         @ crash x and y positions
'CRASHht' STO SWAP
DROP DUP 'CRASHsl'    @ save crash slope
STO SWAP C\->V2 CL\GS @ calculate slope of line to
\GS+ x 3.001 + ht \->V2 @ the landers coordinates
\GS+ LR SWAP DROP
          IF \>=      @ if line segment slope >= the
          THEN 1 SF   @ slope of line to lander,
 v                    @ we crahed.  Set crash flag.
'CRASHv' STO 99 'i'   @ save crash velocity
STO
          END
        ELSE DROP2    @ not within this line segment
        END
      NEXT            @ check next line
    \>>

  MAKBOTTOM           @ generates a list of coordinates
    \<< { } 0 120     @ get an empty list
      FOR a a RAND    @ generate a random y coordinate
25 * IP 6 + 2 \->LIST
1 \->LIST + 12        @ save xy in list, do next
      STEP 130 OVER   @ line up the end points so
1 GET OBJ\-> DROP     @ we don't impact on wrap
SWAP DROP 2 \->LIST 1
\->LIST + 9 RAND * IP @ insure at least one flat line
2 + GETI 2 GET 3
ROLLD GETI 2 5 ROLL
PUT SWAP 1 - SWAP
PUT 'botCOORDS' STO   @ save the list
    \>>

  DRAWBOTTOM          @ maps terraine coordinates to
    \<< 1 botCOORDS   @ screen and display the lines
SIZE 1 -
      FOR i
botCOORDS i GETI
OBJ\-> ROT R\->B ROT 63
SWAP - R\->B ROT
\->LIST 3 ROLLD GET
OBJ\-> ROT R\->B ROT 63
SWAP - R\->B ROT
\->LIST LINE
      NEXT
    \>>

  STATUS              @ displays the flight parameters
    \<<
      \<< + 1 \->GROB
PICT 3 ROLLD REPL
      \>> \-> s
      \<< { # 54h
# 0h } "Height: "
ht s EVAL { # 54h
# 6h } "VertV:  " v
s EVAL { # 54h # Ch
} "HorizV: " hv s
EVAL { # 54h # 12h
} "Fuel:   " fuel s
EVAL
      \>>
    \>>

  GETKEY              @ processes keys
    \<<
      WHILE KEY
      REPEAT
        IF fuel 0 >   @ but only if we got fuel!
        THEN
          CASE DUP
72 ==
            THEN -1
'hv' STO+ -1 'fuel'
STO+
            END DUP
74 ==
            THEN 1
'hv' STO+ -1 'fuel'
STO+
            END DUP
63 ==
            THEN
thrust DUP NEG
'fuel' STO+ 'v'
STO+
            END
          END
        END DROP
      END
    \>>

  NEWC         @ get current screen coordiantes
    \<< x R\->B 57 1 ht
57 MOD 57 / - * R\->B
2 \->LIST
    \>>

  C\->V2       @ convert 2-element list to vector
    \<< OBJ\-> DROP \->V2
    \>>

  SHIP         @ GROB of the lander
GROB 6 6 E13333E11212

  aflag        @ GROB of a flag
GROB 7 7 F7747414F71010

  thrust 2     @ vertical thrust = -1/2 ag

  ag -4        @ acceleration due to gravity

  globals { \GSDAT     @ these are PURGEd
CRASHv CRASHsl
CRASHht CRASHx \GSPAR
botCOORDS fuel x hv
v ht }

END